home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
New Star Software Collection
/
NSS_Collection.iso
/
5-023 bas2com basic compiler
/
1.img
/
LST.LST
< prev
next >
Wrap
File List
|
1980-01-01
|
12KB
|
239 lines
PAGE 1
01-01-80
00:18:00
Offset Data Source Line IBM Personal Computer BASIC Compiler V1.00
001A 0002 1000 ' IBM Personal Computer BASIC Compiler Demonstration Prog
ram
001A 0002 1010 ' Version 1.00 (C)Copyright IBM Corp 1982
001A 0002 1015 ' Licensed Material - Program Property of IBM
001A 0002 1020 '
001A 0002 1030 ON ERROR GOTO 2680
^ /E
002B 0002 1040 HIGH=0:NM$="BASCOM"
003B 000A 1050 DEFINT A-Z
003B 000A 1060 DIM S.STAT(20),S.X(20),S.Y(20),S.SP(20),S.PAT(20),S.PIC$(2
0,1),S.SCORE(20)
003B 01AE 1070 DIM S.LEN(20),BUL(80),SND$(5)
003B 0292 1080 DIM B.X(20),B.Y(20),B.ACT(20)
003B 0310 1090 DIM N.PIC$(10,1),N.SCORE(10),N.SP(10),N.LEN(10)
003B 03AA 1100 DIM X.TOP$(6),X.BOT$(6)
003B 03E2 1110 WIDTH 80:WD=80
0045 03E4 1120 KEY OFF : COLOR 7,0,0 : CLS
005D 03E4 1130 IF WD=80 THEN SCREEN 0,1:LOCATE ,,0
007F 03E4 1140 M$="IBM Personal Computer" : Y=8 : GOSUB 2670
0090 03EA 1150 M$="BASIC Compiler" : Y=10 : GOSUB 2670
00A1 03EA 1160 M$="Demonstration Program" : Y=12 : GOSUB 2670
00B2 03EA 1170 M$="Do you have a color monitor (Y/N)? " : Y=16 : GOSUB 26
70
00C3 03EA 1180 A$=INKEY$:IF A$="" THEN GOTO 1180
00D3 03EE 1190 IF A$="Y" OR A$="y" THEN CLR=1:GOTO 1230
00FE 03F0 1200 IF A$="n" OR A$="N" THEN CLR=0:GOTO 1230
0129 03F0 1210 IF A$=CHR$(3) THEN END
013D 03F0 1220 GOTO 1180
0140 03F0 1230 '
0140 03F0 1240 '
0140 03F0 1250 ' Target Program
0140 03F0 1260 '
0140 03F0 1270 CLS
0143 03F0 1280 M$="TTTTT AAA RRRR GGGG EEEEE TTTTT" : Y=4 : GOSU
B 2670
0154 03F0 1290 M$=" T A A R R G E T " : Y=5 : GOSU
B 2670
0165 03F0 1300 M$=" T A A R R G E T " : Y=6 : GOSU
B 2670
0176 03F0 1310 M$=" T AAAAA RRRR G GG EEE T " : Y=7 : GOSU
B 2670
0187 03F0 1320 M$=" T A A R R G G E T " : Y=8 : GOSU
B 2670
0198 03F0 1330 M$=" T A A R R G G E T " : Y=9 : GOSU
B 2670
01A9 03F0 1340 M$=" T A A R R GGGG EEEEE T " : Y=10: GOSU
B 2670
01BA 03F0 1350 LOCATE 13,1 : PRINT "Instructions:" : PRINT
01D4 03F0 1360 PRINT "Press space bar to fire"
01DB 03F0 1370 PRINT "Press left arrow to move left"
01E2 03F0 1380 PRINT "Press right arrow to move right"
01E9 03F0 1390 PRINT "Press ESC to return to menu"
01F0 03F0 1400 PRINT "Press Ctrl-Break to exit the program"
01F7 03F0 1410 PRINT : PRINT "NOTE - Only 1 shell per position"
PAGE 2
01-01-80
00:18:00
Offset Data Source Line IBM Personal Computer BASIC Compiler V1.00
0205 03F0 1420 PRINT : PRINT "Press any key to continue"
0213 03F0 1430 A$=INKEY$:IF A$="" THEN 1430
0223 03F0 1440 IF A$=CHR$(3) THEN SCREEN 0,0,0:END
0242 03F0 1450 NL = 24 : WIDTH WD :LOCATE ,,0
025A 03F2 1460 IF CLR THEN COLOR 7,1,1
0274 03F2 1470 CLS
0277 03F2 1480 M.S=12
027D 03F4 1490 M.B=12
0283 03F6 1500 M.N=5 : GOSUB 2550
028C 03F8 1510 FOR I=1 TO 5
0292 03F8 1520 X.TOP$(I)="\"+STRING$(I,"|")+"/" : X.BOT$(I)="/"+STRING$
(I,"|")+"\"
02E4 03FA 1530 IF A=3 THEN END
02F1 03FC 1540 NEXT I
02FF 03FC 1550 BULLIT$=CHR$(127)
030A 0400 1560 PLAY "mbt255l32"
0310 0400 1570 LOCATE 25,1 : IF WD=80 THEN PRINT "IBM Personal Computer "
;
032D 0400 1580 PRINT "Basic Compiler Demo"; :
0334 0400 1590 M$="(ESC to restart)" : LOCATE 25,WD-LEN(M$) : PRINT M$;
0355 0400 1600 D.T=12: M.T=(WD-5)*D.T-1
0369 0404 1610 LOCATE NL-1,3 : PRINT STRING$(WD-5,BULLIT$);
0388 0404 1620 FOR I=3 TO WD-3 : BUL(I)=1 : NEXT : NB=WD-5
03BC 0408 1630 FOR I=2 TO NL-1
03C9 040A 1640 LOCATE I,1 : PRINT CHR$(186); : LOCATE I,WD-1 : PRINT CH
R$(186);
03FA 040A 1650 NEXT
040A 040A 1660 LOCATE 1,1 : PRINT CHR$(201);STRING$(WD-3,205);CHR$(187);
0434 040A 1670 LOCATE NL,1 : PRINT CHR$(200);STRING$(WD-3,205);CHR$(188);
0462 040A 1680 LOCATE NL-2,1 : PRINT CHR$(199);STRING$(WD-3,196);CHR$(182
);
0492 040A 1690 BX=WD\2 : LOCATE NL-2,BX : PRINT CHR$(208);
04B8 040C 1700 LOCATE 1,8*(WD/40):PRINT " SCORE = ";SCORE:LOCATE 1,26*(WD
/40):PRINT " TIME LEFT";(899-C.T)\10
0509 0410 1710 FOR C.T=1 TO M.T
0515 0412 1720 FOR I=3 TO M.S
0521 0414 1730 ON S.STAT(I)+1 GOTO 1740,1800,1930,1960,2080,2120
053B 0414 1740 ' Inactive
053B 0414 1750 IF RND>.17 THEN 2190
0548 0414 1760 J=4*RND
0554 0416 1770 S.STAT(I)=1 : S.X(I)=3 : S.Y(I)=I : S.SP(I)=N.SP(J) :
S.PAT(I)=0
0580 0416 1780 S.PIC$(I,0)=N.PIC$(J,0):S.PIC$(I,1)=N.PIC$(J,1) : S.SC
ORE(I)=N.SCORE(J)
05C3 0416 1790 S.LEN(I)=N.LEN(J):LOCATE S.Y(I),S.X(I)-1:PRINT S.PIC$(
I,0); : GOTO 2190
05F9 0416 1800 ' Fly
05F9 0416 1810 X1=S.X(I) : Y=S.Y(I) : X2=S.X(I)+S.LEN(I)
0617 041A 1820 IF C.T AND S.SP(I) THEN X2=X2-1 : GOTO 1860
0636 041A 1830 LOCATE S.Y(I),X1
064A 041A 1840 PRINT S.PIC$(I,S.PAT(I)); : X1=X1+1 : S.X(I)=X1
0678 041A 1850 S.PAT(I)=1-S.PAT(I) : IF X1=WD-7 THEN S.STAT(I)=2
069F 041A 1860 FOR J=0 TO M.B
06AA 041C 1870 IF B.ACT(J)=0 THEN 1910
PAGE 3
01-01-80
00:18:00
Offset Data Source Line IBM Personal Computer BASIC Compiler V1.00
06BA 041C 1880 IF B.Y(J)<>Y THEN 1910
06CD 041C 1890 IF B.X(J)>=X1 THEN IF B.X(J)<=X2 THEN 1900 ELSE 1910
ELSE 1910
06F2 041C 1900 S.STAT(I)=3 : B.ACT(J)=0 : SCORE=SCORE+S.SCORE(I)
0715 041C 1910 NEXT J
0725 041C 1920 GOTO 2190
0728 041C 1930 ' Final
0728 041C 1940 LOCATE S.Y(I),S.X(I) : PRINT " "; : S.STAT(I)=0
0749 041C 1950 GOTO 2190
074C 041C 1960 ' Hit
074C 041C 1970 PLAY SND$(S.LEN(I)-1)
0761 041C 1980 X=S.X(I) : Y=S.Y(I) : LN=S.LEN(I)
077C 0420 1990 IF CLR THEN COLOR 4
078D 0420 2000 LOCATE Y-1,X-1 : PRINT X.TOP$(LN);
07AD 0420 2010 LOCATE Y,X-1 : PRINT "-";
07C3 0420 2020 LOCATE Y,X+LN : PRINT "-";
07DC 0420 2030 LOCATE Y+1,X-1 : PRINT X.BOT$(LN);
07FC 0420 2040 IF CLR THEN COLOR 7
080D 0420 2050 S.STAT(I)=4
0819 0420 2060 LOCATE 1,8*(WD/40):PRINT " SCORE = ";SCORE
083C 0420 2070 GOTO 2190
083F 0420 2080 ' Blown
083F 0420 2090 LOCATE S.Y(I),S.X(I) : PRINT SPC(S.LEN(I));
0861 0420 2100 S.STAT(I)=5
086D 0420 2110 GOTO 2190
0870 0420 2120 ' Down
0870 0420 2130 X=S.X(I) : Y=S.Y(I) : LN=S.LEN(I)+2
088D 0420 2140 LOCATE Y-1,X-1 : PRINT SPC(LN);
08AB 0420 2150 LOCATE Y,X-1 : PRINT SPC(LN);
08C8 0420 2160 LOCATE Y+1,X-1 : PRINT SPC(LN);
08E6 0420 2170 S.STAT(I)=0
08F2 0420 2180 GOTO 2190
08F5 0420 2190 NEXT I
0908 0420 2200 FOR I=0 TO M.B
0913 0422 2210 IF B.ACT(I)=0 THEN 2250
0923 0422 2220 IF B.Y(I)=NL-2 THEN 2240
093A 0422 2230 LOCATE B.Y(I),B.X(I):PRINT " ";:IF B.Y(I)=2 THEN B.ACT
(I)=0:GOTO 2350
0968 0422 2240 B.Y(I)=B.Y(I)-1 : LOCATE B.Y(I),B.X(I) : PRINT BULLIT$
; : GOTO 2350
098F 0422 2250 A$=INKEY$ : IF LEN(A$)=0 THEN 2350
09A2 0422 2260 A=ASC(A$) : IF A<>32 THEN IF A=3 THEN SCREEN 0,0,0:COL
OR 7,0:END ELSE GOTO 2300
09E0 0422 2270 IF BUL(BX)=0 THEN 2300
09F0 0422 2280 BUL(BX)=0 : B.X(I)=BX : B.Y(I)=NL-2 : B.ACT(I)=1:NB=NB
-1
0A1F 0422 2290 LOCATE NL-1,BX : PRINT " "; : PLAY "N35"
0A3B 0422 2300 '
0A3B 0422 2310 IF A=0 THEN A=ASC(MID$(A$,2))-23
0A5A 0422 2320 IF A=52 AND BX>3 THEN BX=BX-1 : LOCATE NL-2,BX : PRINT
CHR$(208);CHR$(196); : GOTO 2350
0AA5 0422 2330 IF A=54 AND BX<WD-3 THEN LOCATE NL-2, BX : BX=BX+1 : P
RINT CHR$(196);CHR$(208);
0AF1 0422 2340 IF A=27 THEN SCORE = 0:GOTO 1270
PAGE 4
01-01-80
00:18:00
Offset Data Source Line IBM Personal Computer BASIC Compiler V1.00
0B04 0422 2350 NEXT I
0B17 0422 2360 IF NB<>0 THEN GOTO 2390
0B21 0422 2370 NB=WD-5:FOR I=3 TO WD-3:BUL(I)=1:NEXT
0B55 0424 2380 LOCATE NL-1,3:PRINT STRING$(WD-5,BULLIT$);
0B74 0424 2390 LOCATE 1,26*(WD/40):PRINT " TIME LEFT";(899-C.T)\10:NEXT
C.T
0BB4 0424 2400 FOR I=0 TO M.B
0BBF 0426 2410 B.Y(I)=2
0BCB 0426 2420 NEXT I
0BDB 0426 2430 CLS:LOCATE 10,16*(WD/40):PRINT "YOUR SCORE WAS ";SCORE
0C01 0426 2440 IF SCORE<=HIGH THEN GOTO 2470
0C0D 0428 2450 HIGH=SCORE:LOCATE 11,10*(WD/40):PRINT "CONGRATULATIONS! TH
AT'S THE NEW HIGH SCORE!"
0C30 0428 2460 LOCATE 15,15*(WD/40):INPUT "TYPE IN YOUR NAME-",NM$:FOR I=
1 TO 20000:NEXT:CLS:SCORE=0:GOTO 1610
0C76 0428 2470 LOCATE 12,17*(WD/40):PRINT "NICE TRY, BUT "
0C93 0428 2480 BEGN=WD/2-LEN(NM$)/2:LOCATE 14,BEGN:PRINT NM$:SCORE=0
0CCE 042A 2490 LOCATE 16,13*(WD/40):PRINT "STILL HAS THE HIGH SCORE -";HI
GH
0CF1 042A 2500 LOCATE 25,30:PRINT "HIT ENTER TO CONTINUE"
0D04 042A 2510 A$=INKEY$:IF A$="" THEN GOTO 2510
0D14 042A 2520 IF A$=CHR$(13) THEN CLS:GOTO 1610
0D2B 042A 2530 IF A$=CHR$(3) THEN SCREEN 0,0,0:COLOR 7,0:END
0D57 042A 2540 GOTO 2510
0D5A 042A 2550 N.PIC$(0,0)=" *" : N.PIC$(0,1)=" +" : N.SCORE(0)=3
0 : N.SP(0)=0
0D76 042A 2560 N.PIC$(1,0)=" **" : N.PIC$(1,1)=" ++" : N.SCORE(1)=2
0 : N.SP(1)=1
0D92 042A 2570 N.PIC$(2,0)=" ***" : N.PIC$(2,1)=" +++" : N.SCORE(2)=1
5 : N.SP(2)=1
0DAE 042A 2580 N.PIC$(3,0)=" ****" : N.PIC$(3,1)=" ++++" : N.SCORE(3)=1
0 : N.SP(3)=3
0DCA 042A 2590 N.PIC$(4,0)=" *****" : N.PIC$(4,1)=" +++++" : N.SCORE(4)=
5 : N.SP(4)=7
0DE6 042A 2600 FOR I=0 TO 10 : N.LEN(I)=I+1 : NEXT
0E05 042A 2610 SND$(0)="N65N56"
0E0D 042A 2620 SND$(1)="N37N47N33"
0E15 042A 2630 SND$(2)="n37N28N35"
0E1D 042A 2640 SND$(3)="N45N35N55N35"
0E25 042A 2650 SND$(4)="N55N35N45N65"
0E2D 042A 2660 RETURN
0E2E 042A 2670 LOCATE Y,(WD-LEN(M$)+2)\2 : PRINT M$; : RETURN
0E57 042A 2680 IF ERR=51 THEN PRINT "INTERNAL ERROR":BEEP:END
0E6F 042A 2690 PRINT "ERROR ";ERR;" ON LINE ";ERL:END
0E8B 042A
0E8E 042A
22151 Bytes Available
17360 Bytes Free
0 Warning Error(s)
1 Severe Error(s)
D$(1)="N37N47N33"
0E15 042A 2630 SND$(2)="n37N28N35"
0E1D 042A 2640 SND$(3)="N45N35N55N35"
0E25 042A 2650